Main

In your final repo, there should be an R markdown file that organizes all computational steps for evaluating your proposed Facial Expression Recognition framework.

This file is currently a template for running evaluation experiments. You should update it according to your codes but following precisely the same structure.

if(!require("EBImage")){
  install.packages("BiocManager")
  BiocManager::install("EBImage")
}
if(!require("R.matlab")){
  install.packages("R.matlab")
}
if(!require("readxl")){
  install.packages("readxl")
}

if(!require("dplyr")){
  install.packages("dplyr")
}
if(!require("readxl")){
  install.packages("readxl")
}

if(!require("ggplot2")){
  install.packages("ggplot2")
}

if(!require("caret")){
  install.packages("caret")
}

if(!require("glmnet")){
  install.packages("glmnet")
}

if(!require("WeightedROC")){
  install.packages("WeightedROC")
}

if(!require("gbm")){
  install.packages("gbm")
}

# Install Miniconda (https://docs.conda.io/en/latest/miniconda.html)
if(!require("keras")){
  install.packages("keras")
}

if(!require("tensorflow")){
  install.packages("tensorflow")
  install_tensorflow()
}

use_condaenv("r-tensorflow")
library(keras)
library(tensorflow)

library(R.matlab)
library(readxl)
library(dplyr)
library(EBImage)
library(ggplot2)
library(caret)
library(glmnet)
library(WeightedROC)
library(gbm)

Step 0 set work directories

set.seed(2020)
# setwd("~/Project3-FacialEmotionRecognition/doc")
# here replace it with your own path or manually set it in RStudio to where this rmd file is located. 
# use relative path for reproducibility

Provide directories for training images. Training images and Training fiducial points will be in different subfolders.

train_dir <- "../data/train_set/" # This will be modified for different data sets.
train_image_dir <- paste(train_dir, "images/", sep="")
train_pt_dir <- paste(train_dir,  "points/", sep="")
train_label_path <- paste(train_dir, "label.csv", sep="") 

Step 1: set up controls for evaluation experiments.

In this chunk, we have a set of controls for the evaluation experiments.

• (T/F) cross-validation on the training set
• (T/F) reweighting the samples for training set
• (number) K, the number of CV folds
• (T/F) process features for training set
• (T/F) run evaluation on an independent test set
• (T/F) process features for test set

# run.cv <- TRUE # run cross-validation on the training set
# sample.reweight <- TRUE # run sample reweighting in model training
# K <- 5  # number of CV folds
# run.feature.train <- TRUE # process features for training set
# run.test <- TRUE # run evaluation on an independent test set
# run.feature.test <- TRUE # process features for test set

sample.reweight <- TRUE # run sample reweighting in model training
K <- 5  # number of CV folds
run.feature.train <- TRUE # process features for training set
run.feature.test <- TRUE # process features for test set

run.cv_gbm <- TRUE # run GBM cross-validation on the training set
run.test_gbm <- TRUE # run GBM evaluation on an independent test set

run.cv_dnn <- TRUE # run DNN cross-validation on the training set
run.test_dnn <- TRUE # run DNN evaluation on an independent test set

Using cross-validation or independent test set evaluation, we compare the performance of models with different specifications. In this part, we tune parameter n.trees and shrinkage for GBM.

# GBM parameters
n.trees  <- c(500, 100, 1500)
shrinkage <- c(0.01, 0.05, 0.1)

Step 2: import data and train-test split

#train-test split
info <- read.csv(train_label_path)
n <- nrow(info)
n_train <- round(n*(4/5), 0)
train_idx <- sample(info$Index, n_train, replace = F)
test_idx <- setdiff(info$Index, train_idx)

If you choose to extract features from images, such as using Gabor filter, R memory will exhaust all images are read together. The solution is to repeat reading a smaller batch(e.g 100) and process them.

n_files <- length(list.files(train_image_dir))

image_list <- list()
for(i in 1:100){
   image_list[[i]] <- readImage(paste0(train_image_dir, sprintf("%04d", i), ".jpg"))
}

Fiducial points are stored in matlab format. In this step, we read them and store them in a list.

#function to read fiducial points
#input: index
#output: matrix of fiducial points corresponding to the index
readMat.matrix <- function(index){
     return(round(readMat(paste0(train_pt_dir, sprintf("%04d", index), ".mat"))[[1]],0))
}

#load fiducial points
fiducial_pt_list <- lapply(1:n_files, readMat.matrix)

strings not representable in native encoding will be translated to UTF-8

save(fiducial_pt_list, file="../output/fiducial_pt_list.RData")

Step 3: construct features and responses

• The follow plots show how pairwise distance between fiducial points can work as feature for facial emotion recognition.

  • In the first column, 78 fiducials points of each emotion are marked in order.
  • In the second column distributions of vertical distance between right pupil(1) and right brow peak(21) are shown in histograms. For example, the distance of an angry face tends to be shorter than that of a surprised face.
  • The third column is the distributions of vertical distances between right mouth corner(50) and the midpoint of the upper lip(52). For example, the distance of an happy face tends to be shorter than that of a sad face.

Figure1

feature.R should be the wrapper for all your feature engineering functions and options. The function feature( ) should have options that correspond to different scenarios for your project and produces an R object that contains features and responses that are required by all the models you are going to evaluate later.

• feature.R
• Input: list of images or fiducial point
• Output: an RData file that contains extracted features and corresponding responses

source("../lib/feature.R")
tm_feature_train <- NA
if(run.feature.train){
  tm_feature_train <- system.time(dat_train <- feature(fiducial_pt_list, train_idx))
  save(dat_train, file="../output/feature_train.RData")
}else{
  load(file="../output/feature_train.RData")
}

tm_feature_test <- NA
if(run.feature.test){
  tm_feature_test <- system.time(dat_test <- feature(fiducial_pt_list, test_idx))
  save(dat_test, file="../output/feature_test.RData")
}else{
  load(file="../output/feature_test.RData")
}

GBM

Step 4: Train a classification model with training features and responses

Call the train model and test model from library.

train.R and test.R should be wrappers for all your model training steps and your classification/prediction steps.

• train.R
  • Input: a data frame containing features and labels and a parameter list.
  • Output:a trained model
• test.R
  • Input: the fitted classification model using training data and processed features from testing images
  • Input: an R object that contains a trained classifier.
  • Output: training model specification
• In this part, we use GBM (baseline model) to do classification.

source("../lib/train_gbm.R") 
source("../lib/test_gbm.R")

Model selection with cross-validation

• Do model selection by choosing among different values of training model parameters.

source("../lib/cross_validation_gbm.R")
feature_train = as.matrix(dat_train[, -6007])
label_train = as.integer(dat_train$label)
if(run.cv_gbm){
  res_cv_gbm <- matrix(0, nrow = length(n.trees) * length(shrinkage), ncol = 6)
  count = 0
  for(i in 1:length(n.trees)){
    for(j in 1:length(shrinkage)){
      count = count + 1
      cat("n.trees =", n.trees[i], "\n")
      cat("shrinkage =", shrinkage[j], "\n")
      res_cv <- cv.function_gbm(features = feature_train, labels = label_train, K,
                              n.trees[i], shrinkage[j], reweight = sample.reweight)
      
      res_cv_gbm[count,] <- c(n.trees[i], shrinkage[j], res_cv[1], res_cv[2], res_cv[3], res_cv[4])
    }
  }
  
  colnames(res_cv_gbm) <- c("n.trees","shrinkage","mean_error", "sd_error", "mean_AUC", "sd_AUC")
  save(res_cv_gbm, file="../output/res_cv_gbm.RData")
}else{
  load("../output/res_cv_gbm.RData")
}

n.trees = 500 
shrinkage = 0.01 
n.trees = 500 
shrinkage = 0.05 
n.trees = 500 
shrinkage = 0.1 
n.trees = 100 
shrinkage = 0.01 
n.trees = 100 
shrinkage = 0.05 
n.trees = 100 
shrinkage = 0.1 
n.trees = 1500 
shrinkage = 0.01 
n.trees = 1500 
shrinkage = 0.05 
n.trees = 1500 
shrinkage = 0.1 

Visualize cross-validation results.

res_cv_gbm <- as.data.frame(res_cv_gbm) 

if(run.cv_gbm){
  p1 <- res_cv_gbm %>% 
    ggplot(aes(x = n.trees, y = mean_error,
               ymin = mean_error - sd_error, ymax = mean_error + sd_error)) + 
    geom_crossbar() +
    facet_wrap(~shrinkage)+
    theme(axis.text.x = element_text(angle = 90, hjust = 1))
  
  p2 <- res_cv_gbm %>% 
    ggplot(aes(x = n.trees, y = mean_AUC,
               ymin = mean_AUC - sd_AUC, ymax = mean_AUC + sd_AUC)) + 
    geom_crossbar() +
    facet_wrap(~shrinkage)+
    theme(axis.text.x = element_text(angle = 90, hjust = 1))
  
  print(p1)
  print(p2)
}

• Choose the “best” parameter value

# par_n.trees_best <- as.numeric(res_cv_gbm[which.min(res_cv_gbm$mean_error), 1])
# par_shrinkage_best <- as.numeric(res_cv_gbm[which.min(res_cv_gbm$mean_error), 2])

par_n.trees_best <- 500
par_shrinkage_best <- 0.05

• Train the model with the entire training set using the selected model (model parameter) via cross-validation.

# training weights
weight_train <- rep(NA, length(label_train))
for (v in unique(label_train)){
  weight_train[label_train == v] = 0.5 * length(label_train) / length(label_train[label_train == v])
}
if (sample.reweight){
  tm_train <- system.time(fit_train <- train_gbm(feature_train, label_train, w = weight_train, par_n.trees_best, par_shrinkage_best))
} else {
  tm_train <- system.time(fit_train <- train_gbm(feature_train, label_train, w = NULL, par_n.trees_best, par_shrinkage_best))
}
save(fit_train, file="../output/fit_train_gbm.RData")

Step 5: Run test on test images

tm_test = NA
feature_test <- as.matrix(dat_test[, -6007])
if(run.test_gbm){
  load(file="../output/fit_train_gbm.RData")
  tm_test <- system.time({prob_pred <- test_gbm(fit_train, feature_test, par_n.trees_best, pred.type = 'response');})
}

• evaluation

label_test <- as.integer(dat_test$label)

# DELETE
save(feature_test, file="../output/feature_test_tmp_only.RData")

Error in save(feature_test, file = "../output/feature_test_tmp_only.RData") : 
  目标对象‘feature_test’不存在

Summarize Running Time

Prediction performance matters, so does the running times for constructing features and for training the model, especially when the computation resource is limited.

cat("Time for constructing training features=", tm_feature_train[1], "s \n")

Time for constructing training features= 0.64 s 

cat("Time for constructing testing features=", tm_feature_test[1], "s \n")

Time for constructing testing features= 0.12 s 

cat("Time for training model=", tm_train[1], "s \n") 

Time for training model= 80.55 s 

cat("Time for testing model=", tm_test[1], "s \n")

Time for testing model= 0.12 s 

DNN

Step 4: Train a classification model with training features and responses

Call the train model and test model from library.

train.R and test.R should be wrappers for all your model training steps and your classification/prediction steps.

• train.R
  • Input: a data frame containing features and labels and a parameter list.
  • Output:a trained model
• test.R
  • Input: the fitted classification model using training data and processed features from testing images
  • Input: an R object that contains a trained classifier.
  • Output: training model specification
• In this part, we use GBM (baseline model) to do classification.

source("../lib/train_dnn.R") 
source("../lib/test_dnn.R")

Model selection with cross-validation

• Do model selection by choosing among different values of training model parameters.

source("../lib/cross_validation_dnn.R")
feature_train = as.matrix(dat_train[, -6007])
label_train = as.integer(dat_train$label)

# if(run.cv_dnn){
#   res_cv_dnn <- matrix(0, 1, ncol = 4)
#   
#   res_cv <- cv.function_dnn(features = feature_train, labels = label_train, K,
#                           reweight = sample.reweight)
#   
#   res_cv_dnn[1,] <- c(res_cv[1], res_cv[2], res_cv[3], res_cv[4])
#   
#   colnames(res_cv_dnn) <- c("mean_error", "sd_error", "mean_AUC", "sd_AUC")
#   save(res_cv_dnn, file="../output/res_cv_dnn.RData")
# }else{
#   load("../output/res_cv_dnn.RData")
# }

Visualize cross-validation results.

# res_cv_dnn <- as.data.frame(res_cv_dnn) 
# 
# if(run.cv_dnn){
#   p1 <- res_cv_dnn %>% 
#     ggplot(aes(x = "DNN", y = mean_error,
#                ymin = mean_error - sd_error, ymax = mean_error + sd_error)) + 
#     geom_crossbar() +
#     theme(axis.text.x = element_text())
#   
#   p2 <- res_cv_dnn %>% 
#     ggplot(aes(x = "DNN", y = mean_AUC,
#                ymin = mean_AUC - sd_AUC, ymax = mean_AUC + sd_AUC)) + 
#     geom_crossbar() +
#     theme(axis.text.x = element_text())
#   
#   print(p1)
#   print(p2)
# }

• Choose the “best” parameter value

# par_n.trees_best <- as.numeric(res_cv_gbm[which.min(res_cv_gbm$mean_error), 1])
# par_shrinkage_best <- as.numeric(res_cv_gbm[which.min(res_cv_gbm$mean_error), 2])

• Train the model with the entire training set using the selected model (model parameter) via cross-validation.

source("../lib/train_dnn.R") 
source("../lib/test_dnn.R")

feature_train = as.matrix(dat_train[, -6007])
label_train = as.integer(dat_train$label)
feature_test <- as.matrix(dat_test[, -6007])
label_test <- as.integer(dat_test$label)
label_test <- ifelse(label_test == 2, 0, 1)
weight_test <- rep(NA, length(label_test))

# training weights
weight_train <- rep(NA, length(label_train))
for (v in unique(label_train)){
  weight_train[label_train == v] = 0.5 * length(label_train) / length(label_train[label_train == v])
}

for (v in unique(label_test)){
  weight_test[label_test == v] = 0.5 * length(label_test) / length(label_test[label_test == v])
}

# validation_split <- 1 / 5
# validation_split <- 0
tm_train <- NA
if (sample.reweight){
  tm_train <- system.time(fit_train <- train_dnn(feature_train, label_train, w = weight_train, feature_test, label_test, weight_test))
} else {
  tm_train <- system.time(fit_train <- train_dnn(feature_train, label_train, w = NULL, feature_test, label_test, weight_test = NULL))
}

  1/480 [..............................] - ETA: 0s - loss: 0.7364 - accuracy: 0.6000
  4/480 [..............................] - ETA: 6s - loss: 0.4994 - accuracy: 0.7000
  7/480 [..............................] - ETA: 7s - loss: 1.0844 - accuracy: 0.7429
 10/480 [..............................] - ETA: 7s - loss: 1.7769 - accuracy: 0.7200
 13/480 [..............................] - ETA: 7s - loss: 1.7024 - accuracy: 0.7231
 16/480 [>.............................] - ETA: 7s - loss: 1.5212 - accuracy: 0.7000
 19/480 [>.............................] - ETA: 7s - loss: 1.4686 - accuracy: 0.6632
 22/480 [>.............................] - ETA: 7s - loss: 1.3905 - accuracy: 0.6455
 25/480 [>.............................] - ETA: 7s - loss: 1.3442 - accuracy: 0.6080
 28/480 [>.............................] - ETA: 7s - loss: 1.3168 - accuracy: 0.5786
 31/480 [>.............................] - ETA: 7s - loss: 1.2960 - accuracy: 0.5548
 34/480 [=>............................] - ETA: 7s - loss: 1.3006 - accuracy: 0.5471
 37/480 [=>............................] - ETA: 7s - loss: 1.3099 - accuracy: 0.5459
 40/480 [=>............................] - ETA: 7s - loss: 1.2814 - accuracy: 0.5450
 43/480 [=>............................] - ETA: 7s - loss: 1.2587 - accuracy: 0.5395
 46/480 [=>............................] - ETA: 7s - loss: 1.2075 - accuracy: 0.5565
 49/480 [==>...........................] - ETA: 7s - loss: 1.1759 - accuracy: 0.5633
 52/480 [==>...........................] - ETA: 7s - loss: 1.1447 - accuracy: 0.5538
 55/480 [==>...........................] - ETA: 7s - loss: 1.1477 - accuracy: 0.5491
 58/480 [==>...........................] - ETA: 7s - loss: 1.1282 - accuracy: 0.5483
 61/480 [==>...........................] - ETA: 7s - loss: 1.0982 - accuracy: 0.5508
 64/480 [===>..........................] - ETA: 7s - loss: 1.0816 - accuracy: 0.5594
 67/480 [===>..........................] - ETA: 7s - loss: 1.0922 - accuracy: 0.5552
 70/480 [===>..........................] - ETA: 6s - loss: 1.1125 - accuracy: 0.5543
 73/480 [===>..........................] - ETA: 6s - loss: 1.1091 - accuracy: 0.5479
 76/480 [===>..........................] - ETA: 6s - loss: 1.0961 - accuracy: 0.5447
 79/480 [===>..........................] - ETA: 6s - loss: 1.0903 - accuracy: 0.5291
 82/480 [====>.........................] - ETA: 6s - loss: 1.0778 - accuracy: 0.5293
 85/480 [====>.........................] - ETA: 6s - loss: 1.0688 - accuracy: 0.5200
 88/480 [====>.........................] - ETA: 6s - loss: 1.0699 - accuracy: 0.5182
 91/480 [====>.........................] - ETA: 6s - loss: 1.0587 - accuracy: 0.5209
 94/480 [====>.........................] - ETA: 6s - loss: 1.0887 - accuracy: 0.5277
 97/480 [=====>........................] - ETA: 6s - loss: 1.0596 - accuracy: 0.5402
100/480 [=====>........................] - ETA: 6s - loss: 1.0499 - accuracy: 0.5480
103/480 [=====>........................] - ETA: 6s - loss: 1.0461 - accuracy: 0.5515
106/480 [=====>........................] - ETA: 6s - loss: 1.0546 - accuracy: 0.5547
109/480 [=====>........................] - ETA: 6s - loss: 1.0432 - accuracy: 0.5596
112/480 [======>.......................] - ETA: 6s - loss: 1.0295 - accuracy: 0.5589
115/480 [======>.......................] - ETA: 6s - loss: 1.0226 - accuracy: 0.5600
118/480 [======>.......................] - ETA: 6s - loss: 1.0146 - accuracy: 0.5610
121/480 [======>.......................] - ETA: 6s - loss: 1.0088 - accuracy: 0.5570
124/480 [======>.......................] - ETA: 6s - loss: 1.0161 - accuracy: 0.5532
127/480 [======>.......................] - ETA: 6s - loss: 1.0262 - accuracy: 0.5512
130/480 [=======>......................] - ETA: 6s - loss: 1.0196 - accuracy: 0.5523
133/480 [=======>......................] - ETA: 5s - loss: 1.0163 - accuracy: 0.5489
136/480 [=======>......................] - ETA: 5s - loss: 1.0131 - accuracy: 0.5441
139/480 [=======>......................] - ETA: 5s - loss: 1.0070 - accuracy: 0.5439
142/480 [=======>......................] - ETA: 5s - loss: 1.0020 - accuracy: 0.5451
145/480 [========>.....................] - ETA: 5s - loss: 0.9966 - accuracy: 0.5434
148/480 [========>.....................] - ETA: 5s - loss: 0.9970 - accuracy: 0.5405
151/480 [========>.....................] - ETA: 5s - loss: 0.9939 - accuracy: 0.5404
154/480 [========>.....................] - ETA: 5s - loss: 0.9915 - accuracy: 0.5403
157/480 [========>.....................] - ETA: 5s - loss: 0.9900 - accuracy: 0.5376
160/480 [=========>....................] - ETA: 5s - loss: 0.9872 - accuracy: 0.5337
163/480 [=========>....................] - ETA: 5s - loss: 0.9874 - accuracy: 0.5325
166/480 [=========>....................] - ETA: 5s - loss: 0.9820 - accuracy: 0.5265
169/480 [=========>....................] - ETA: 5s - loss: 0.9771 - accuracy: 0.5266
172/480 [=========>....................] - ETA: 5s - loss: 0.9768 - accuracy: 0.5244
175/480 [=========>....................] - ETA: 5s - loss: 0.9786 - accuracy: 0.5257
178/480 [==========>...................] - ETA: 5s - loss: 0.9735 - accuracy: 0.5281
181/480 [==========>...................] - ETA: 5s - loss: 0.9806 - accuracy: 0.5260
184/480 [==========>...................] - ETA: 5s - loss: 0.9748 - accuracy: 0.5261
187/480 [==========>...................] - ETA: 5s - loss: 0.9684 - accuracy: 0.5241
190/480 [==========>...................] - ETA: 5s - loss: 0.9684 - accuracy: 0.5242
193/480 [===========>..................] - ETA: 4s - loss: 0.9721 - accuracy: 0.5244
196/480 [===========>..................] - ETA: 4s - loss: 0.9735 - accuracy: 0.5245
199/480 [===========>..................] - ETA: 4s - loss: 0.9864 - accuracy: 0.5226
202/480 [===========>..................] - ETA: 4s - loss: 0.9795 - accuracy: 0.5228
205/480 [===========>..................] - ETA: 4s - loss: 0.9765 - accuracy: 0.5220
208/480 [============>.................] - ETA: 4s - loss: 0.9748 - accuracy: 0.5231
211/480 [============>.................] - ETA: 4s - loss: 0.9733 - accuracy: 0.5213
214/480 [============>.................] - ETA: 4s - loss: 0.9743 - accuracy: 0.5187
217/480 [============>.................] - ETA: 4s - loss: 0.9714 - accuracy: 0.5143
220/480 [============>.................] - ETA: 4s - loss: 0.9705 - accuracy: 0.5127
223/480 [============>.................] - ETA: 4s - loss: 0.9649 - accuracy: 0.5112
226/480 [=============>................] - ETA: 4s - loss: 0.9578 - accuracy: 0.5150
229/480 [=============>................] - ETA: 4s - loss: 0.9495 - accuracy: 0.5188
232/480 [=============>................] - ETA: 4s - loss: 0.9496 - accuracy: 0.5198
235/480 [=============>................] - ETA: 4s - loss: 0.9541 - accuracy: 0.5226
238/480 [=============>................] - ETA: 4s - loss: 0.9538 - accuracy: 0.5218
241/480 [==============>...............] - ETA: 4s - loss: 0.9494 - accuracy: 0.5212
244/480 [==============>...............] - ETA: 4s - loss: 0.9464 - accuracy: 0.5197
247/480 [==============>...............] - ETA: 4s - loss: 0.9438 - accuracy: 0.5206
250/480 [==============>...............] - ETA: 4s - loss: 0.9420 - accuracy: 0.5192
253/480 [==============>...............] - ETA: 3s - loss: 0.9373 - accuracy: 0.5194
256/480 [===============>..............] - ETA: 3s - loss: 0.9392 - accuracy: 0.5180
259/480 [===============>..............] - ETA: 3s - loss: 0.9357 - accuracy: 0.5166
262/480 [===============>..............] - ETA: 3s - loss: 0.9347 - accuracy: 0.5168
265/480 [===============>..............] - ETA: 3s - loss: 0.9290 - accuracy: 0.5177
268/480 [===============>..............] - ETA: 3s - loss: 0.9275 - accuracy: 0.5194
271/480 [===============>..............] - ETA: 3s - loss: 0.9254 - accuracy: 0.5188
274/480 [================>.............] - ETA: 3s - loss: 0.9216 - accuracy: 0.5212
277/480 [================>.............] - ETA: 3s - loss: 0.9181 - accuracy: 0.5213
280/480 [================>.............] - ETA: 3s - loss: 0.9167 - accuracy: 0.5229
283/480 [================>.............] - ETA: 3s - loss: 0.9152 - accuracy: 0.5265
286/480 [================>.............] - ETA: 3s - loss: 0.9175 - accuracy: 0.5259
289/480 [=================>............] - ETA: 3s - loss: 0.9161 - accuracy: 0.5260
292/480 [=================>............] - ETA: 3s - loss: 0.9154 - accuracy: 0.5240
295/480 [=================>............] - ETA: 3s - loss: 0.9142 - accuracy: 0.5220
298/480 [=================>............] - ETA: 3s - loss: 0.9116 - accuracy: 0.5221
301/480 [=================>............] - ETA: 3s - loss: 0.9088 - accuracy: 0.5229
304/480 [==================>...........] - ETA: 3s - loss: 0.9098 - accuracy: 0.5211
307/480 [==================>...........] - ETA: 3s - loss: 0.9076 - accuracy: 0.5225
310/480 [==================>...........] - ETA: 2s - loss: 0.9049 - accuracy: 0.5219
313/480 [==================>...........] - ETA: 2s - loss: 0.9054 - accuracy: 0.5208
316/480 [==================>...........] - ETA: 2s - loss: 0.9049 - accuracy: 0.5190
319/480 [==================>...........] - ETA: 2s - loss: 0.9013 - accuracy: 0.5185
322/480 [===================>..........] - ETA: 2s - loss: 0.8990 - accuracy: 0.5174
325/480 [===================>..........] - ETA: 2s - loss: 0.8953 - accuracy: 0.5182
328/480 [===================>..........] - ETA: 2s - loss: 0.8963 - accuracy: 0.5171
331/480 [===================>..........] - ETA: 2s - loss: 0.8968 - accuracy: 0.5196
334/480 [===================>..........] - ETA: 2s - loss: 0.8952 - accuracy: 0.5210
337/480 [====================>.........] - ETA: 2s - loss: 0.8934 - accuracy: 0.5175
340/480 [====================>.........] - ETA: 2s - loss: 0.8953 - accuracy: 0.5176
343/480 [====================>.........] - ETA: 2s - loss: 0.8953 - accuracy: 0.5155
346/480 [====================>.........] - ETA: 2s - loss: 0.8929 - accuracy: 0.5173
349/480 [====================>.........] - ETA: 2s - loss: 0.8902 - accuracy: 0.5169
352/480 [=====================>........] - ETA: 2s - loss: 0.8903 - accuracy: 0.5165
355/480 [=====================>........] - ETA: 2s - loss: 0.8897 - accuracy: 0.5161
358/480 [=====================>........] - ETA: 2s - loss: 0.8872 - accuracy: 0.5173
361/480 [=====================>........] - ETA: 2s - loss: 0.8861 - accuracy: 0.5163
364/480 [=====================>........] - ETA: 2s - loss: 0.8847 - accuracy: 0.5165
367/480 [=====================>........] - ETA: 1s - loss: 0.8824 - accuracy: 0.5166
370/480 [======================>.......] - ETA: 1s - loss: 0.8810 - accuracy: 0.5178
373/480 [======================>.......] - ETA: 1s - loss: 0.8825 - accuracy: 0.5169
376/480 [======================>.......] - ETA: 1s - loss: 0.8823 - accuracy: 0.5170
379/480 [======================>.......] - ETA: 1s - loss: 0.8823 - accuracy: 0.5156
382/480 [======================>.......] - ETA: 1s - loss: 0.8823 - accuracy: 0.5136
385/480 [=======================>......] - ETA: 1s - loss: 0.8809 - accuracy: 0.5138
388/480 [=======================>......] - ETA: 1s - loss: 0.8792 - accuracy: 0.5124
391/480 [=======================>......] - ETA: 1s - loss: 0.8768 - accuracy: 0.5125
394/480 [=======================>......] - ETA: 1s - loss: 0.8748 - accuracy: 0.5127
397/480 [=======================>......] - ETA: 1s - loss: 0.8753 - accuracy: 0.5134
400/480 [========================>.....] - ETA: 1s - loss: 0.8728 - accuracy: 0.5155
403/480 [========================>.....] - ETA: 1s - loss: 0.8732 - accuracy: 0.5161
406/480 [========================>.....] - ETA: 1s - loss: 0.8722 - accuracy: 0.5158
409/480 [========================>.....] - ETA: 1s - loss: 0.8696 - accuracy: 0.5169
412/480 [========================>.....] - ETA: 1s - loss: 0.8705 - accuracy: 0.5155
415/480 [========================>.....] - ETA: 1s - loss: 0.8686 - accuracy: 0.5137
418/480 [=========================>....] - ETA: 1s - loss: 0.8676 - accuracy: 0.5124
421/480 [=========================>....] - ETA: 1s - loss: 0.8664 - accuracy: 0.5116
424/480 [=========================>....] - ETA: 0s - loss: 0.8652 - accuracy: 0.5104
427/480 [=========================>....] - ETA: 0s - loss: 0.8639 - accuracy: 0.5101
430/480 [=========================>....] - ETA: 0s - loss: 0.8662 - accuracy: 0.5088
433/480 [==========================>...] - ETA: 0s - loss: 0.8638 - accuracy: 0.5099
436/480 [==========================>...] - ETA: 0s - loss: 0.8638 - accuracy: 0.5110
439/480 [==========================>...] - ETA: 0s - loss: 0.8613 - accuracy: 0.5112
442/480 [==========================>...] - ETA: 0s - loss: 0.8580 - accuracy: 0.5118
445/480 [==========================>...] - ETA: 0s - loss: 0.8626 - accuracy: 0.5119
448/480 [===========================>..] - ETA: 0s - loss: 0.8603 - accuracy: 0.5134
451/480 [===========================>..] - ETA: 0s - loss: 0.8627 - accuracy: 0.5122
454/480 [===========================>..] - ETA: 0s - loss: 0.8627 - accuracy: 0.5119
457/480 [===========================>..] - ETA: 0s - loss: 0.8618 - accuracy: 0.5120
460/480 [===========================>..] - ETA: 0s - loss: 0.8614 - accuracy: 0.5117
463/480 [===========================>..] - ETA: 0s - loss: 0.8603 - accuracy: 0.5123
466/480 [============================>.] - ETA: 0s - loss: 0.8584 - accuracy: 0.5112
469/480 [============================>.] - ETA: 0s - loss: 0.8576 - accuracy: 0.5113
472/480 [============================>.] - ETA: 0s - loss: 0.8566 - accuracy: 0.5106
475/480 [============================>.] - ETA: 0s - loss: 0.8540 - accuracy: 0.5107
478/480 [============================>.] - ETA: 0s - loss: 0.8566 - accuracy: 0.5113
480/480 [==============================] - 8s 18ms/step - loss: 0.8548 - accuracy: 0.5121

480/480 [==============================] - 9s 18ms/step - loss: 0.8548 - accuracy: 0.5121 - val_loss: 0.7072 - val_accuracy: 0.6617

cat("time--------------------------------", tm_train[c(1,2,3)])

time-------------------------------- 52.8 12.32 11.83

save_model_hdf5(fit_train, "../output/fit_train_dnn.h5")

Step 5: Run test on test images

tm_test = NA
feature_test <- as.matrix(dat_test[, -6007])
if(run.test_dnn){
  fit_train <- load_model_hdf5("../output/fit_train_dnn.h5")
  tm_test <- system.time({label_pred <- test_dnn(fit_train, feature_test, type = "predict_classes");
   prob_pred <- test_dnn(fit_train, feature_test, type = "predict_proba")})
}

• evaluation

## reweight the test data to represent a balanced label distribution
label_test <- as.integer(dat_test$label)

weight_test <- rep(NA, length(label_test))
for (v in unique(label_test)){
  weight_test[label_test == v] = 0.5 * length(label_test) / length(label_test[label_test == v])
}

label_test <- ifelse(label_test == 2, 0, 1)

accu <- sum(weight_test * (label_pred == label_test)) / sum(weight_test)

# prob_pred <- apply(prob_pred, 1, max)
head(label_pred)

[1] 1 0 1 1 1 1

head(prob_pred)

             [,1]      [,2]
[1,] 6.481969e-06 0.9999936
[2,] 5.308085e-01 0.4691916
[3,] 3.749197e-06 0.9999963
[4,] 8.148937e-33 1.0000000
[5,] 4.023731e-01 0.5976269
[6,] 5.316924e-02 0.9468307

prob_pred <- prob_pred[, 2]
head(prob_pred)

[1] 0.9999936 0.4691916 0.9999963 1.0000000 0.5976269 0.9468307

tpr.fpr <- WeightedROC(prob_pred, label_test, weight_test)
auc <- WeightedAUC(tpr.fpr)


cat("The accuracy of model:", "DNN", "is", accu*100, "%.\n")

The accuracy of model: DNN is 74.04045 %.

cat("The AUC of model:", "DNN", "is", auc, ".\n")

The AUC of model: DNN is 0.8018793 .

Summarize Running Time

Prediction performance matters, so does the running times for constructing features and for training the model, especially when the computation resource is limited.

cat("Time for constructing training features=", tm_feature_train[1], "s \n")

Time for constructing training features= 0.6 s 

cat("Time for constructing testing features=", tm_feature_test[1], "s \n")

Time for constructing testing features= 0.13 s 

cat("Time for training model=", tm_train[1], "s \n") 

Time for training model= 5331.72 s 

cat("Time for testing model=", tm_test[1], "s \n")

Time for testing model= 1.19 s 

###Reference - Du, S., Tao, Y., & Martinez, A. M. (2014). Compound facial expressions of emotion. Proceedings of the National Academy of Sciences, 111(15), E1454-E1462.